home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 40
/
Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso
/
Aminet
/
misc
/
emu
/
ATUtilities.lha
/
ATUtilities
/
BASIC
/
STRGAD.BAS
< prev
next >
Wrap
BASIC Source File
|
2000-09-26
|
2KB
|
126 lines
screen 12
call DrawNBorder(10,10,40,1)
locate 11,12
gad.id=0
gad.text$(gad.id)="Dies ist ein Testtext"
gad.x(gad.id)=10
gad.y(gad.id)=10
gad.w(gad.id)=40
gad.strmax(gad.id)=37
key 25,chr$(0,&H53)
on key(12) gosub links
on key(13) gosub rechts
on key(25) gosub del
key(12) on
key(13) on
key(25) on
sp=len(gad.text$(gad.id))
mx=gad.strmax(gad.id)
cursor=sp
undo$=gad.text$(gad.id)
call Neu
i$=inkey$
call MouseDown
while i$<>chr$(13) and mouse.button=0
if i$<>"" then
select case i$
case chr$(8)
if sp>0 and cursor>0 then
q$=gad.text$(gad.id)
gad.text$(gad.id)=left$(q$,cursor-1)+mid$(q$,cursor+1,sp-cursor)
cursor=cursor-1
sp=sp-1
call Neu
else
sound 2000,1
end if
case chr$(27)
gad.text$(gad.id)=undo$
sp=len(undo$)
call Neu
case else
if asc(i$)>30 then
if sp<mx then
q$=gad.text$(gad.id)
gad.text$(gad.id)=left$(q$,cursor)+i$+mid$(q$,cursor+1,sp-cursor)
sp=sp+1 : cursor=cursor+1
call Neu
else
sound 2000,1
end if
else
sound 2000,1
end if
end select
end if
i$=inkey$
call MouseDown
wend
cursor=33333
call Neu
key(12) off
key(13) off
key(25) off
end
links:
if cursor>0 then
cursor=cursor-1
call Neu
end if
return
rechts:
if cursor<sp then
cursor=cursor+1
call Neu
end if
return
del:
if cursor<sp and sp>0 then
q$=gad.text$(gad.id)
gad.text$(gad.id)=left$(q$,cursor)+mid$(q$,cursor+2,sp-cursor)
sp=sp-1
if cursor>sp then cursor=cursor-1
call Neu
end if
return
sub Neu shared
call MouseOff
locate gad.y(gad.id)+1,gad.x(gad.id)+2
color 15
z$=gad.text$(gad.id)+string$(1+gad.strmax(gad.id)-len(gad.text$(gad.id))," ")
print z$;
if cursor<33333 then
color 14
locate gad.y(gad.id)+1,gad.x(gad.id)+2+cursor
z$=mid$(z$,cursor+1,1)
if z$=" " then z$="_"
print z$;
end if
call MouseOn
end sub
sub MouseOff static
end sub
sub MouseOn static
end sub
sub MouseDown static
end sub
sub DrawNBorder(x,y,w,h) static
x1=x*8-4
y1=y*16-8
x2=x1+(w*8)+8
y2=y1+(h*16)+16
line (x1,y1)-(x2,y2),15,b
end sub